home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1994 December / PSL Monthly Shareware CD-ROM (Public Software Library)(December 1994).bin / prgmming / dos / pascal4 / pas1.art < prev    next >
Text File  |  1991-10-19  |  10KB  |  214 lines
  1.         Turbo Pascal is a language which has had many faces.  Since
  2. Borland introduced it in 1982 it has been everything from a purely
  3. teaching language to the high power Turbo Pascal we know today.  But,
  4. the makers of Turbo Pascal have not forgotten its roots.  Today, Turbo
  5. Pascal can be used in writing the simplest application to the most
  6. complex high-speed parrallel processing network applications.
  7.  
  8.         The program below illustrates how easy it is to use Turbo Pascal
  9. to writing a seemingly complex application.  The code is for a program
  10. much like the popular TheDraw~.  This code took me less than 2 hours to
  11. write and is less that 170 lines of code.  With a few additions it could
  12. easily rival any of the popular ANSI Drawing programs... some even like
  13. TheDraw~ which have made their authors a pretty penny!
  14.  
  15. -----------> Beginning of Listing
  16.  
  17. Program ANSIPic;   { The following code may be modified, changed and  }
  18.                    { used in any way you wish.  It may be distributed }
  19. Uses CRT;          { in whole or part and you do NOT have to credit   }
  20.                    { OctagonSoft or Ben Shoval for the code           }
  21. const
  22.   UpArrow   = #72; { These Constants are used to define cursor movements }
  23.   DnArrow   = #80;
  24.   RtArrow   = #77;
  25.   LtArrow   = #75;
  26.   ColorUp   = #73; { These are used to define the keys for changing colors }
  27.   ColorDn   = #81;
  28.   BkColorUp = #71;
  29.   BkColorDn = #79;
  30.   SetDMKey  = #50;
  31.   TRtCorner = #59; { These define the keys for drawing corners }
  32.   TLtCorner = #60;
  33.   BRtCorner = #61;
  34.   BLtCorner = #62;
  35.   ClrKey    = #46; { Key to Clear the Screen }
  36.  
  37. var
  38.   DrawColor : Byte; { Stores the foreground color }
  39.   BKColor   : Byte; { Stores the background color }
  40.   Ch        : Char;
  41.  
  42. Procedure Setup;
  43. Begin
  44.   TextMode(CO80);         { Use 80 by 25 Text Mode }
  45.   HighVideo;              { Use High Intensity Colors }
  46.   TextColor(White);       { Set the starting Foreground color to White }
  47.   DrawColor := White;     { Set the Foreground color variable }
  48.   TextBackground(Black);  { Set the starting Background color to Black }
  49.   BKColor := Black;       { Set the Background color variable }
  50.   ClrScr;                 { Clear the Screen }
  51.   GotoXY(1,1);            { The Following sets up the screen }
  52.   Write('PgUp/PgGn Sets Color - Home/End Sets Background Color - ');
  53.   Write('<ALT>M Toggles Drawing');
  54.   GotoXY(1,25);
  55.   Write('Status: ');
  56.   GotoXY(25,25);
  57.   Write('Cursor Position: ');
  58.   GotoXY(60,25);
  59.   Write('F1 ',#218,' F2 ',#191,' F3 ',#192,' F4 ',#217);
  60.   GotoXY(40,12);          { Put the cursor in the center of the screen }
  61. End;
  62.  
  63. Procedure Draw;
  64. Var
  65.   HiKey      : Boolean; { Set to TRUE is the keypressed is an Extended Key }
  66.   DrawMode   : Boolean; { Set to TRUE if in Drawing Mode }
  67.   PreX, PreY : Byte;    { Used to hold X and Y when they are being written }
  68. Begin
  69.   DrawMode := TRUE;     { Always start out in Drawing Mode }
  70.   Repeat                { Start of loop which exits with ESC or <ALT>X }
  71.  
  72.     PreX := WhereX;     { Get the current X pos }
  73.     PreY := WhereY;     { Get the current Y pos }
  74.     GotoXY(42,25);      { Go to 42,25 to write the current X and Y }
  75.     TextColor(White);   { Writing will be done with White on Black }
  76.     TextBackground(Black);
  77.     Write('(',+PreX,+',',+PreY,+')     '); { The spaces after then ) are needed }
  78.     GotoXY(9,25); { The Following write the Drawing Status }
  79.     if DrawMode = TRUE then Write('Drawing    ') { Spaces are needed }
  80.     else Write('Not Drawing');
  81.     GotoXY(PreX, PreY); { Go back to where you were on the screen }
  82.  
  83.     if DrawColor = BkColor then { Check that the foreground and background }
  84.       inc(DrawColor);           { colors are not the same                  }
  85.     TextColor(DrawColor);       { Set the Foreground color }
  86.     TextBackground(BKColor);    { Set the Background color }
  87.  
  88.     HiKey := False;             { Always assume that it is NOT a Hi Key }
  89.     Ch := Readkey;              { Read a key }
  90.     If Ch=#0 then               { If it is a Hi Key (#0 was returned first) }
  91.       Begin
  92.         Ch := Readkey;          { If we got here then it is a Hi Key }
  93.         HiKey := TRUE;          { Set HiKey to TRUE }
  94.       End;
  95.  
  96.     Case Ch Of
  97.       UpArrow   : Begin { Routine if the Up Arrow was pressed }
  98.                     GotoXY(WhereX,WhereY-1); { Move up a line }
  99.                     if WhereY = 1 then GotoXY(WhereX,2); { make sure we're }
  100.                     if DrawMode = True then              { not on 1st line }
  101.                       Begin  { We're here if we're in drawing mode }
  102.                         Write(#179);
  103.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  104.                       End;                       { character which was drawn}
  105.                   End;
  106.       DnArrow   : Begin { Routine if the Down Arrow was pressed }
  107.                     GotoXY(WhereX,WhereY+1); { Move down a line }
  108.                     If WhereY = 25 then GotoXY(WhereX,24); { make sure we're }
  109.                     if DrawMode = True then                { not on 25th line}
  110.                       Begin
  111.                         Write(#179);
  112.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  113.                       End;                       { character which was drawn}
  114.                   End;
  115.       RtArrow   : Begin { Routine if the Right Arrow was pressed }
  116.                     GotoXY(WhereX+1,WhereY); { Move to the right one position }
  117.                     if WhereX = 80 then GotoXY(79,WhereY); { make sure we're }
  118.                     if DrawMode = True then                { not in 79th spot}
  119.                       Begin
  120.                         Write(#196);
  121.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  122.                       End;                       { character which was drawn}
  123.                   End;
  124.       LtArrow   : Begin { Routine if the Left Arrow was pressed }
  125.                     GotoXY(WhereX-1,WhereY); { Move to the left one position }
  126.                     if DrawMode = True then
  127.                       Begin
  128.                         Write(#196);
  129.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  130.                       End;                       { character which was drawn}
  131.                   End;
  132.       ColorUp   : If DrawColor < 15 then inc(DrawColor) { Foreground colors }
  133.                   else DrawColor := 0;                  { are from 0 to 15  }
  134.       ColorDn   : If DrawColor > 0 then dec(DrawColor)
  135.                   else DrawColor := 15;
  136.       BkColorUp : if BkColor < 15 then inc(BkColor)     { Background colors }
  137.                   else BkColor := 0;                    { are from 0 to 7   }
  138.       BkColorDn : if BkColor > 0 then dec(BkColor)
  139.                   else BkColor := 15;
  140.       SetDMKey  : If HiKey = TRUE then { make sure we have a Hi Key }
  141.                     if DrawMode = TRUE then DrawMode := FALSE
  142.                     else DrawMode := TRUE;          { Toggle Draw Mode }
  143.       TRtCorner : if HiKey = TRUE then   { Routine to Draw Top Right Corner }
  144.                     begin
  145.                       write(#218);
  146.                       GotoXY(WhereX-1,WhereY);
  147.                      end;
  148.       TLtCorner : if HiKey = TRUE then   { Routine to Draw Top Left Corner  }
  149.                     begin
  150.                       write(#191);
  151.                       GotoXY(WhereX-1,WhereY);
  152.                     end;
  153.       BRtCorner : if HiKey = TRUE then { Routine to Draw Bottom Right Corner }
  154.                     begin
  155.                       write(#192);
  156.                       GotoXY(WhereX-1,WhereY);
  157.                     end;
  158.       BLtCorner : if HiKey = TRUE then { Routine to Draw Bottom Left Corner }
  159.                     begin
  160.                       write(#217);
  161.                       GotoXY(WhereX-1,WhereY);
  162.                     end;
  163.  
  164.       ClrKey    : if HiKey = TRUE then Setup; { Clear the Screen }
  165.       #32..#136 : If HiKey = FALSE then { Routine to write an ASCII }
  166.                     Begin               { character to the screen   }
  167.